PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/fimode.com/TP5PATCH.PAS

Pascal/Delphi Source File | 1989-03-21 | 10.8 KB | 363 lines

{
   TP5Patch   Version 1.0   3/20/89

   by Richard S. Sadowsky
   CIS 74017,1670
   donated to the public domain with no restrictions on use
}

{$S-,R-,I-,V-}

program TP5Patch;

{
  This program alters the File Mode byte associated with the opening of
  Overlay files and text files opened for reading (with Reset). For some
  reason, Turbo Pascal 5 ignores the global FileMode variable when opening
  overlay and text files for reading. The program does not correct this
  oversight, but does allow you to customize the Mode byte which is used to
  open these files. If you look at the assembly snippets extracted from the
  Overlay.TPU and System.TPU files, you'll note the problem (and see the
  solution). The problem is that the file mode associated with these files is
  hardcoded in the statement

    MOV  AX,3D00

  Luckily, this also means that solving the problem is as simple as replacing
  the 00 in AL with a more appropriate value. By default, this program will
  change the low byte to 40h (deny-none). This should result in these files
  being shareable over a network without any bad side effects when running
  single user. It is not appropriate here to enter a lengthy discussion of
  other possible modes. Suffice to say that 40h should solve the main
  problem--the inability to share Overlay and text files by more than one
  program over a LAN.

  To explicitly set the file mode to a value other the default of 40h, use the
  command line option -mxx, where xx is the hex value of the new mode. The mode
  is always interpreted as a hex number, so a leading '$' or trailing 'h' is
  not necessary (or permitted). The option -? shows a help message. Specifying
  a file name on the command line will instruct TP5Patch to patch the
  appropriate bytes in an already compiled TP5 EXE file. If a filename is
  specified on the command line, then TP5Patch will not patch TURBO.TPL,
  SYSTEM.TPU or OVERLAY.TPU (just the file mode or modes within the EXE file
  are patched). The option -oxx is used to specify what the file mode currently
  is so that a previously patched file may be re-patched to a new value.

  Example command lines:

  TP5Patch
    Will look for SYSTEM.TPU, OVERLAY.TPU, and TURBO.TPL. It will patch those
    found with the default file mode of 40h.

  TP5Patch -m42
    Will look for SYSTEM.TPU, OVERLAY.TPU, and TURBO.TPL. It will patch those
    found with the specified file mode of 42h.

  TP5Patch NETDEMO.EXE -m42
    Will patch the TP5 program NETDEMO.EXE with the specified file mode of 42h.

  TP5Patch NETDEMO.EXE -m42 -o40
    Will patch the TP5 program NETDEMO.EXE with the specified file mode of 42h.
    NetDEMO had already been patched with 40h.

  This program DOES NOT MAKE A BACKUP of files before patching them. Please do
  so before running this program.


  Thee patching process boils down to searching for the following pieces of
  code and patching the AL argument of the DOS function 3Dh call with the new
  file mode.

  For overlay file mode look for the following code:
          16           PUSH    SS
          1F           POP     DS
          B8003D       MOV     AX,3D00
          CD21         INT     21
          C3           RET

  For text file mode look for the following code:
          B8003D       MOV     AX,3D00
          817D02B1D7   CMP     WORD PTR [DI+02],D7B1
          740D         JZ      1EF0
          B002         MOV     AL,02
}
const
  OverlayMatchPattern : Array[1..8] of Byte =
                                         ($16,$1F,$B8,$00,$3D,$CD,$21,$C3);

  SystemMatchPattern : Array[1..14] of Byte =
                                         ($B8,$00,$3D,$81,$7D,$02,$B1,$D7,
                                          $74,$0D,$B0,$02,$FF,$05);
  NewMode : Byte = $40;
  JustReport : Boolean = FALSE;
  PatchingExe : Boolean = FALSE;

  BufferSize = $FFF0;

  OverlayUnit = 'OVERLAY.TPU';
  SystemUnit = 'SYSTEM.TPU';
  TurboTPL = 'TURBO.TPL';

type
  BufferType = Array[1..BufferSize] of Byte;

var
  OvrFileSize : Word;
  F : File;
  Buffer : ^BufferType;
  FileToPatch : String;

function Search(var BufToSearch; BufSize : Word;
                var BufToFind; FindSize : Word) : Word;
{-A quick and dirty memory search routine}
const
  MaxWord = $FFFF;

type
  SearchBuffer = Array[1..MaxWord] of Byte;

var
  I,II : Word;
  Buf : SearchBuffer absolute BufToSearch;
  Find : SearchBuffer absolute BufToFind;
  Found,StillMatches : Boolean;
begin
  Search := 0;
  if (BufSize = 0) or (FindSize = 0) or (FindSize > BufSize) then
    Exit;
  I := 1;
  Found := FALSE;
  while (not Found) and (I <= (BufSize-FindSize+1)) do begin
    if Buf[I] = Find[1] then begin
      II := 1;
      StillMatches := TRUE;
      while (II < FindSize) and StillMatches do begin
        if Buf[I+II] <> Find[Succ(II)] then
          StillMatches := FALSE;
        Inc(II);
      end;
      if (II = FindSize) and StillMatches then
        Found := TRUE;
    end;
    if not Found then
      Inc(I);
  end;
  if Found then
    Search := I;
end;

procedure ShowHelp;
{-Display program options is halt}
begin
  WriteLn('TP5Patch [-?] [-m00] [filename.exe]'^M^J);
  WriteLn('  -? displays this help message');
  WriteLn('  -m sets file mode, may be specified in hex (default is 40h)');
  WriteLn('  -o specifies the old mode to search for and patch');
  WriteLn('  filename.exe refers to a Turbo Pascal EXE file to patch directly');
  Halt;
end;

function GetHexNum(S : String) : Word;
{-Convert a string representing a hex number to a word (0 if invalid) }
var
  W,Code : Word;

begin
  S := '$' + S;
  Val(S,W,Code);
  if Code = 0 then
    GetHexNum := W
  else
    GetHexNum := 0;
end;

function Nybble(x : Byte): Char;
inline($58/            {  POP     AX     }
       $24/$0F/        {  AND     AL,0F  }
       $04/$90/        {  ADD     AL,90  }
       $27/            {  DAA            }
       $14/$40/        {  ADC     AL,40  }
       $27/            {  DAA            }
       $24/$7F);       {  AND     AL,7F  }

function HexByte(H : Byte): String;
{-byte to hex string}
begin
  HexByte[0] := #2;
  HexByte[1] := Nybble(H shr 4);
  HexByte[2] := Nybble(H);
end;

procedure GetOptions;
{-Parse the command line}
var
  I : Byte;
  OldMode : Byte;
  Opt : String;
begin
  for I := 1 to ParamCount do begin
    Opt := ParamStr(I);
    if Opt[1] in ['-','/'] then
      case UpCase(Opt[2]) of
        'M' : begin
                NewMode := GetHexNum(Copy(Opt,3,Length(Opt)));
                WriteLn('Using a file mode of ',HexByte(NewMode),'h'^M^J);
              end;
        'O' : begin
                OldMode := GetHexNum(Copy(Opt,3,Length(Opt)));
                if OldMode <> 0 then begin
                  OverlayMatchPattern[4] := OldMode;
                  SystemMatchPattern[2] := OldMode;
                end;
              end;
        '?','H' : ShowHelp;
        else begin
          WriteLn('Invalid option ',Opt);
        end;
      end
    else begin
      FileToPatch := Opt;
      PatchingEXE := TRUE;
    end;
  end;
end;

procedure IOCheck(S : String);
{-abort on I/O error  with message}
var
  E : Word;
begin
  E := IOResult;
  if E <> 0 then begin
    WriteLn('IOResult = ',E);
    WriteLn(S);
    Halt;
  end;
end;

procedure PatchMode(FName : String; var MatchPattern;
                    MatchSize,OffsetInMatch : Word);
{-Patch the specified file. Look for MatchPattern and patch at the
 OffsetInMatch to NewMode.}

var
  F : File;
  Posit,FSize : Word;

begin
  Assign(F,FName);
  Reset(F,1);
  if IOResult <> 0 then begin
    WriteLn(FName,' not found');
    Exit;
  end;

  BlockRead(F,Buffer^,SizeOf(BufferType),FSize);
  IOCheck('Error reading '+FName);
  WriteLn(FSize,' bytes read from ',FName);
  Posit := Search(Buffer^,FSize,MatchPattern,MatchSize);
  if Posit = 0 then begin
    WriteLn('Patch point not found');
    Close(F);
    if IOResult <> 0 then ;
    Exit;
  end;
  Seek(F,Posit+(OffsetInMatch-2));
  IOCheck('Seek error in '+FName);
  BlockWrite(F,NewMode,SizeOf(Byte));
  IOCheck('Error writing '+FName);
  Close(F);
  if IOResult = 0 then
    WriteLn(FName,' patched')
  else
    WriteLn('I/O error saving ',FName);
end;

procedure LookForPatchPoints(Size : Word; var TxtPosit,OvrPosit : Word);
{-Find patch points in buffer}
begin
  OvrPosit := Search(Buffer^,Size,OverlayMatchPattern,
                     SizeOf(OverlayMatchPattern));
  TxtPosit := Search(Buffer^,Size,SystemMatchPattern,
                     SizeOf(SystemMatchPattern));
end;

procedure PatchByte(var F : File; Offs : Longint; var Bite : Byte);
{-Seek Offs within F, and write new Byte Bite}
begin
  Seek(F,Offs);
  IOCheck('Error seeking '+FileToPatch);
  BlockWrite(F,Bite,SizeOf(Bite));
  IOCheck('Error writing '+FileToPatch);
end;

procedure PatchDiskFile;
{-Patch a user specified EXE file}
var
  Overlap1,Overlap2 : ^BufferType;
  Size,Posit : LongInt;
  NumRead,TxtPosit,OvrPosit : Word;
  FoundOvr,FoundText : Boolean;

begin
  Assign(F,FileToPatch);
  Reset(F,1);
  IOCheck(FileToPatch + ' not found');
  Size := FileSize(F);
  FoundOvr := False;
  FoundText := False;
  Posit := 0;
  while (Posit < Size) and (not (FoundOvr and FoundText)) do begin
    Seek(F,Posit);
    IOCheck('Error seeking '+FileToPatch);
    BlockRead(F,Buffer^,SizeOf(Buffer^),NumRead);

    LookForPatchPoints(NumRead,TxtPosit,OvrPosit);
    if TxtPosit > 0 then begin
      FoundText := True;
      PatchByte(F,Posit+TxtPosit,NewMode);
    end;
    if OvrPosit > 0 then begin
      FoundOvr := True;
      PatchByte(F,Posit+OvrPosit+2,NewMode);
    end;

    Inc(Posit,NumRead);
    if Posit < Size then
      Dec(Posit,SizeOf(SystemMatchPattern));
  end;
  if FoundOvr then
    WriteLn('Overlay file open patched in ',FileToPatch)
  else
    WriteLn(FileToPatch,' does not use TP5 Overlays (or already patched).');
  if FoundText then
    WriteLn('Text file open (reset) patched in ',FileToPatch)
  else begin
    WriteLn('Patch point not found for SYSTEM.TPU code in ',FileToPatch);
    WriteLn('Either already patched or not a Turbo Pascal 5 program.');
  end;
end;

procedure PatchTPLandTPUs;
{-Look for TURBO.TPL, SYSTEM.TPU and OVERLAY.TPU and patch those found}
begin
  PatchMode(OverlayUnit,OverlayMatchPattern,SizeOf(OverlayMatchPattern),4);
  PatchMode(SystemUnit,SystemMatchPattern,SizeOf(SystemMatchPattern),2);
  PatchMode(TurboTPL,OverlayMatchPattern,SizeOf(OverlayMatchPattern),4);
  PatchMode(TurboTPL,SystemMatchPattern,SizeOf(SystemMatchPattern),2);
end;

begin
  WriteLn('TP5Patch version 1.0 - Patches Overlay and Text File Modes'^M^J);
  FileToPatch := '';
  GetOptions;
  New(Buffer);

  if PatchingEXE then
    PatchDiskFile
  else
    PatchTPLandTPUs;

  Dispose(Buffer);
end.